#    This file is part of robo-ircbot.
#
#    robo-ircbot is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    robo-ircbot is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with robo-ircbot.  If not, see <http://www.gnu.org/licenses/>.

package App::Modular::Module::Eval;
use strict;
use warnings;
use Safe;
use threads('yield', 'exit' => 'threads_only');
use base qw(App::Modular::Module);

print ":: Eval module loaded.\n";

# Events we want to receive.
sub events { return "PRIVMSG"; }

sub help {
        return (
                "Safe perl script evaluation.",
                "eval <perl code here...>"
        );
}

# PRIVMSG events.
sub event_privmsg
{
        shift;
        my $e = shift;

        my $help = $e->robo->mod("Helper") || return;

        # Admin commands for eval module.
        if ($help->trigger_switch("eval", $e)) {
                return;
        }

        # Eval trigger.
        if ($e->data =~ /^\.eval (.+)/) {
                my $thread_eval = threads->create('eval_thread', $e, $1);
                my $thread_timeout = threads->create('eval_timeout', $e, $thread_eval, 2);

                my @ret = $thread_eval->join();
                $thread_timeout->detach();
        }
}

# Performs the safe evaluation.
sub eval_thread
{
        my ($e, $one) = @_;

        # Create safe compartment.
        my $compartment = new Safe;
        $compartment->permit_only(
                qw(join rand pushre regcmaybe regcreset regcomp subst substcont concat padany :base_core :base_loop)
        );

        # Thread 'cancellation' signal handler
        $SIG{'KILL'} = sub {
                threads->exit() if threads->can('exit');
                exit(0);
        };

        # Evaluate the expression.
        my $result = $compartment->reval($one);
        $result = $@ if $@;

        # No result.
        if (!defined($result)) {
                $e->s("PRIVMSG ".$e->dest." :eval: No result returned!");
                return;
        }

        # Results sometimes have multiple lines, so split it.
        my @results = split(/\n/, $result);

        # Print out each line of the results.
        foreach (@results) {
                $e->s("PRIVMSG ".$e->dest." :eval: ".$_);
                sleep(1);
        }
}

# Kills the eval thread if it runs for too long.
sub eval_timeout
{
        my ($e, $thread, $timeout) = @_;

        # This determines how long we let our eval thread run for.
        sleep($timeout);

        # If the thread is still running, stop it.
        if ($thread && $thread->is_running()) {
                $e->s("PRIVMSG ".$e->dest.
                      " :eval: Evaluation terminated (exceeded alotted time of ".
                      $timeout." seconds).");
                $thread->kill('KILL')->detach();
        }
}

1;
